Analysis of contextualized sensorimotor norms
Sean Trott
January 19, 2026
Introduction
In this document, we analyze the contextualized sensorimotor norms: judgments about the strength of different sensorimotor dimensions of ambiguous words, in context.
We use these norms in several analyses:
- First, we compare them to the corresponding dimensions for the “decontextualized” Lancaster sensorimotor norms.
- Second, we ask whether the dominance of a word
sense is correlated with its sensorimotor strength, i.e., whether more
concrete meanings tend to be rated as more dominant.
- Third, we ask whether the sensorimotor distance between two contexts of use predicts judgments of how related those meanings are, above and beyond their distributional similarity and whether or not they belong to the same sense.
- Fourth, we use sensorimotor distance to predict behavior on a primed sensibility judgment task.
Characterizing dimensions
First, load the data.
df_contextualized_meanings = read_csv("../../data/processed/contextualized_sensorimotor_norms.csv")## New names:
## Rows: 448 Columns: 28
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (3): word, sentence, context dbl (25): ...1, Vision.M, Vision.SD, Hearing.M,
## Hearing.SD, Olfaction.M, Olf...
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`nrow(df_contextualized_meanings)## [1] 448Visualizing distributions
df_contextualized_meanings_long = df_contextualized_meanings %>%
pivot_longer(cols = c(Vision.M, Hearing.M, Olfaction.M,
Taste.M, Interoception.M, Touch.M,
Mouth_throat.M, Head.M, Torso.M,
Hand_arm.M, Foot_leg.M),
names_to = "Dimension",
values_to = "Strength") %>%
mutate(Dimension = gsub('.M', '', Dimension))
df_contextualized_meanings_long %>%
ggplot(aes(x = reorder(Dimension, Strength),
y = Strength)) +
geom_violin() +
geom_jitter(alpha = .1,
width = .1) +
coord_flip() +
labs(y = "Sensorimotor strength",
x = "Dimension") +
theme_bw() +
theme(text = element_text(size=20))
Correlations across dimensions
columns = df_contextualized_meanings %>%
mutate(Vision = Vision.M,
Hearing = Hearing.M,
Olfaction = Olfaction.M,
Taste = Taste.M,
Interoception = Interoception.M,
Touch = Touch.M,
Mouth_throat = Mouth_throat.M,
Head = Head.M,
Torso = Torso.M,
Hand_arm = Hand_arm.M,
Foot_leg = Foot_leg.M) %>%
select(Vision, Hearing, Olfaction,
Taste, Interoception, Touch,
Mouth_throat, Head, Torso,
Hand_arm, Foot_leg)
cors = cor(columns)
# cors[lower.tri(cors, diag=TRUE)] <- 0
# Plot the correlation matrix
ggcorrplot(cors,
hc.order = FALSE,
# method = "square",
type = "upper") +
theme(
axis.text.x = element_text(size = 10, angle = 45, hjust = 1),
axis.text.y = element_text(size = 10)
)
Visualizing specific words
df_contextualized_meanings_long %>%
group_by(word, Dimension) %>%
mutate(Strength_scaled = scale(Strength)) %>%
filter(word == "market") %>%
ggplot(aes(x = reorder(Dimension, Strength_scaled),
y = Strength_scaled,
fill = Dimension)) +
geom_bar(stat = "identity") +
theme_bw() +
coord_flip() +
labs(x = "Dimension",
y = "Sensorimotor Strength (z-scored)") +
facet_wrap(~sentence) +
scale_fill_manual(values = viridisLite::viridis(11, option = "mako",
begin = 0.8, end = 0.15)) +
theme(text = element_text(size=16)) +
guides(fill=FALSE)## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Predicting dominance
Load and merge data
Load the item-level means for the sensorimotor norms.
df_contextualized_meanings = read_csv("../../data/processed/contextualized_sensorimotor_norms_with_ls.csv")## New names:
## Rows: 448 Columns: 30
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (3): word, sentence, context dbl (27): ...1, Unnamed: 0, Vision.M, Vision.SD,
## Hearing.M, Hearing.SD, Olfa...
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`nrow(df_contextualized_meanings)## [1] 448Load the dominance norms.
df_dominance = read_csv("../../data/processed/dominance_norms_with_order.csv")## New names:
## Rows: 896 Columns: 6
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (3): word, version_with_order, ambiguity_type dbl (3): ...1, dominance_right,
## sd_dominance
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`## Determine the specific sense/meaning of the righthand context
df_dominance = df_dominance %>%
mutate(context = substr(version_with_order, 6, 9))
## Now group by that righthand context to get relative dominance of that meaning
df_dominance_individual = df_dominance %>%
group_by(word, context) %>%
summarise(dominance = mean(dominance_right))## `summarise()` has grouped output by 'word'. You can override using the
## `.groups` argument.nrow(df_dominance_individual)## [1] 448Merge the dominance and sensorimotor norms data.
df_dom_plus_sm = df_contextualized_meanings %>%
inner_join(df_dominance_individual)## Joining with `by = join_by(word, context)`nrow(df_dom_plus_sm)## [1] 448We also load and merge the Lancaster norms, as a control.
df_lancaster = read_csv("../../data/lexical/lancaster_norms.csv")## Rows: 39707 Columns: 45
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): Word, Dominant.perceptual, Dominant.action, Dominant.sensorimotor,...
## dbl (39): Auditory.mean, Gustatory.mean, Haptic.mean, Interoceptive.mean, Ol...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_lancaster = df_lancaster %>%
mutate(word = tolower(Word)) %>%
select(-Foot_leg.SD, -Torso.SD, -Head.SD, -Hand_arm.SD)
df_dom_plus_sm = df_dom_plus_sm %>%
inner_join(df_lancaster)## Joining with `by = join_by(word)`nrow(df_dom_plus_sm)## [1] 448Calculating contextualized sensorimotor strength
Based on Lynott et al (2019), we contextualized sensorimotor strength as the maximum strength across all the dimensions.
df_dom_plus_sm = df_dom_plus_sm %>%
rowwise() %>%
mutate(max_strength = max(
c(
## Modalities
Vision.M,
Hearing.M,
Olfaction.M,
Touch.M,
Taste.M,
Interoception.M,
## Effectors
Head.M,
Mouth_throat.M,
Torso.M,
Hand_arm.M,
Foot_leg.M
)
),
max_perceptual_strength = max(
c(
## Modalities
Vision.M,
Hearing.M,
Olfaction.M,
Touch.M,
Taste.M,
Interoception.M
)
),
max_action_strength = max(
c(
## Effectors
Head.M,
Mouth_throat.M,
Torso.M,
Hand_arm.M,
Foot_leg.M
)
)
) %>%
ungroup()
df_dom_plus_sm %>%
ggplot(aes(x = Max_strength.sensorimotor,
y = max_strength)) +
geom_point(alpha = .5) +
labs(y = "Maximum Contextualized Strength",
x = "Maximum Strength (Lancaster)") +
theme_bw()
cor.test(df_dom_plus_sm$Max_strength.sensorimotor,
df_dom_plus_sm$max_strength)##
## Pearson's product-moment correlation
##
## data: df_dom_plus_sm$Max_strength.sensorimotor and df_dom_plus_sm$max_strength
## t = 10.373, df = 446, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.3630485 0.5125743
## sample estimates:
## cor
## 0.440865Does contextualized sensorimotor strength predict dominance?
The answer is yes: contexts with a higher maximum sensorimotor strength also tend to be rated as more dominant.
Notably, this is true above and beyond the decontextualized ratings of sensorimotor strength for a given word.
df_dom_plus_sm %>%
ggplot(aes(x = max_strength,
y = dominance)) +
geom_point(alpha = .4) +
geom_smooth(method = "lm") +
labs(x = "Maximum Contextualized Strength",
y = "Dominance") +
theme_minimal() +
theme(text = element_text(size=16))## `geom_smooth()` using formula = 'y ~ x'
model_full = lmer(data = df_dom_plus_sm,
dominance ~
max_strength +
Max_strength.sensorimotor + Minkowski3.sensorimotor +
(1 | word),
REML = FALSE)## boundary (singular) fit: see help('isSingular')model_reduced = lmer(data = df_dom_plus_sm,
dominance ~
# max_strength +
Max_strength.sensorimotor + Minkowski3.sensorimotor +
(1 | word),
REML = FALSE)## boundary (singular) fit: see help('isSingular')summary(model_full)## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
## method [lmerModLmerTest]
## Formula:
## dominance ~ max_strength + Max_strength.sensorimotor + Minkowski3.sensorimotor +
## (1 | word)
## Data: df_dom_plus_sm
##
## AIC BIC logLik -2*log(L) df.resid
## 1070.7 1095.3 -529.4 1058.7 442
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -2.30770 -0.76937 -0.01941 0.78910 2.13757
##
## Random effects:
## Groups Name Variance Std.Dev.
## word (Intercept) 0.0000 0.0000
## Residual 0.6221 0.7887
## Number of obs: 448, groups: word, 112
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) -0.47619 0.24549 448.00000 -1.940 0.0530 .
## max_strength 0.25833 0.05964 448.00000 4.332 1.83e-05 ***
## Max_strength.sensorimotor 0.02905 0.10851 448.00000 0.268 0.7891
## Minkowski3.sensorimotor -0.13254 0.07421 448.00000 -1.786 0.0748 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) mx_str Mx_st.
## max_strngth -0.366
## Mx_strngth. -0.430 -0.070
## Mnkwsk3.sns 0.032 -0.244 -0.789
## optimizer (nloptwrap) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')anova(model_full, model_reduced)## Data: df_dom_plus_sm
## Models:
## model_reduced: dominance ~ Max_strength.sensorimotor + Minkowski3.sensorimotor + (1 | word)
## model_full: dominance ~ max_strength + Max_strength.sensorimotor + Minkowski3.sensorimotor + (1 | word)
## npar AIC BIC logLik -2*log(L) Chisq Df Pr(>Chisq)
## model_reduced 5 1087.1 1107.6 -538.54 1077.1
## model_full 6 1070.7 1095.3 -529.35 1058.7 18.381 1 1.808e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1df_dom_plus_sm %>%
mutate(resid = residuals(model_reduced)) %>%
ggplot(aes(x = max_strength,
y = resid)) +
geom_point(alpha = .4) +
geom_smooth(method = "lm") +
labs(x = "Maximum Contextualized Strength",
y = "Residuals (Reduced model)") +
theme_bw()## `geom_smooth()` using formula = 'y ~ x'
Which dimension best predicts dominance?
Here, we ask whether specific dimensions are particularly correlated with sense dominance.
features <- c("Vision.M", "Hearing.M", "Olfaction.M", "Touch.M", "Taste.M",
"Interoception.M", "Head.M", "Mouth_throat.M", "Torso.M",
"Hand_arm.M", "Foot_leg.M")
# Models with each feature + baseline covariate
r2_results <- map_dfr(features, function(feat) {
formula <- as.formula(paste0("dominance ~ Max_strength.sensorimotor + ", feat))
model <- lm(formula, data = df_dom_plus_sm)
tibble(
feature = feat,
R2 = summary(model)$r.squared,
beta = coef(model)[3], # coefficient for the feature (3rd term now)
p_value = summary(model)$coefficients[3, 4]
)
})
# Baseline model (just Max_strength.sensorimotor)
baseline_model <- lm(dominance ~ Max_strength.sensorimotor, data = df_dom_plus_sm)
baseline_row <- tibble(
feature = "Baseline",
R2 = summary(baseline_model)$r.squared,
beta = NA,
p_value = NA
)
# Combine
r2_results_with_baseline <- bind_rows(baseline_row, r2_results)
# Plot
r2_results_with_baseline %>%
mutate(feature = str_remove(feature, "\\.M$"),
feature = str_replace(feature, "_", "/"),
sig = ifelse(p_value < .05, "*", ""),
is_baseline = feature == "Baseline",
feature = fct_reorder(feature, R2)) %>%
ggplot(aes(x = R2, y = feature, fill = is_baseline)) +
geom_col() +
geom_text(aes(label = sig), hjust = -0.5, size = 6, na.rm = TRUE) +
scale_fill_manual(values = c("grey40", "steelblue"), guide = "none") +
labs(x = "R²", y = NULL, title = "Predicting Sense Dominance") +
theme_minimal() +
theme(text = element_text(size = 16))
cor.test(df_dom_plus_sm$Touch.M,
df_dom_plus_sm$dominance)##
## Pearson's product-moment correlation
##
## data: df_dom_plus_sm$Touch.M and df_dom_plus_sm$dominance
## t = 3.5374, df = 446, p-value = 0.0004464
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.07368382 0.25395880
## sample estimates:
## cor
## 0.1652009cor.test(df_dom_plus_sm$Vision.M,
df_dom_plus_sm$dominance)##
## Pearson's product-moment correlation
##
## data: df_dom_plus_sm$Vision.M and df_dom_plus_sm$dominance
## t = 4.0423, df = 446, p-value = 6.235e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.09703963 0.27583493
## sample estimates:
## cor
## 0.1879943It looks like vision and touch are especially strong predictors. Which items drive this, e.g., for touch?
by_sense <- df_dom_plus_sm %>%
mutate(sense = str_extract(context, "M[12]")) %>%
group_by(word, sense) %>%
summarize(
mean_touch = mean(Touch.M),
mean_vision = mean(Vision.M),
mean_dom = mean(dominance),
.groups = "drop"
)
# Now 2 rows per word—compute within-word difference
sense_diffs <- by_sense %>%
pivot_wider(names_from = sense,
values_from = c(mean_touch, mean_vision, mean_dom)) %>%
mutate(
touch_diff = mean_touch_M1 - mean_touch_M2,
vision_diff = mean_vision_M1 - mean_vision_M2,
dom_diff = mean_dom_M1 - mean_dom_M2
)
sense_diffs %>%
mutate(abs_touch_diff = abs(touch_diff)) %>%
arrange(desc(abs_touch_diff)) %>%
select(word, abs_touch_diff, dom_diff) %>%
head(5)## # A tibble: 5 × 3
## word abs_touch_diff dom_diff
## <chr> <dbl> <dbl>
## 1 punch 2.87 -1.54
## 2 spill 2.49 2.44
## 3 racket 2.48 -1.92
## 4 clip 2.01 0.102
## 5 case 1.99 -0.894sense_diffs %>%
mutate(abs_vision_diff = abs(vision_diff)) %>%
arrange(desc(abs_vision_diff)) %>%
select(word, abs_vision_diff, dom_diff) %>%
head(5)## # A tibble: 5 × 3
## word abs_vision_diff dom_diff
## <chr> <dbl> <dbl>
## 1 break 2.02 1.30
## 2 block 2.02 0.810
## 3 spill 1.96 2.44
## 4 market 1.80 0.941
## 5 drain 1.73 -2.08# Does the sense with higher Touch or Vision tend to be more dominant?
cor.test(sense_diffs$touch_diff, sense_diffs$dom_diff)##
## Pearson's product-moment correlation
##
## data: sense_diffs$touch_diff and sense_diffs$dom_diff
## t = 2.8459, df = 110, p-value = 0.005284
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.08021574 0.42669538
## sample estimates:
## cor
## 0.2618737cor.test(sense_diffs$vision_diff, sense_diffs$dom_diff)##
## Pearson's product-moment correlation
##
## data: sense_diffs$vision_diff and sense_diffs$dom_diff
## t = 4.4908, df = 110, p-value = 1.758e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.2244579 0.5397527
## sample estimates:
## cor
## 0.3936196Comparing dimensions to Lancaster
Now, we compare each dimension to the LS Norms.
df_diffs = df_dom_plus_sm %>%
mutate(vision_diff = (Vision.M - Visual.mean),
auditory_diff = (Hearing.M - Auditory.mean),
intero_diff = (Interoception.M - Interoceptive.mean),
olfactory_diff = (Olfaction.M - Olfactory.mean),
touch_diff = (Touch.M - Haptic.mean),
taste_diff = (Taste.M - Gustatory.mean),
torso_diff = (Torso.M - Torso.mean),
hand_arm_diff = (Hand_arm.M - Hand_arm.mean),
foot_leg_diff = (Foot_leg.M - Foot_leg.mean),
head_diff = (Head.M - Head.mean),
mouth_throat_diff = (Mouth_throat.M - Mouth.mean)) %>%
pivot_longer(cols = c(vision_diff,
auditory_diff,
intero_diff,
olfactory_diff,
touch_diff,
taste_diff,
torso_diff,
hand_arm_diff,
foot_leg_diff,
head_diff,
mouth_throat_diff),
names_to = "Dimension",
values_to = "Diff") %>%
mutate(Dimension = gsub('_diff', '', Dimension)) %>%
mutate(Dimension = case_when(
Dimension == "intero" ~ "Interoception",
Dimension == "auditory" ~ "Hearing",
Dimension == "olfactory" ~ "Olfaction",
TRUE ~ str_to_title(Dimension)
))
df_diffs$Dimension = factor(df_diffs$Dimension,
levels = rev(c(
'Vision',
'Hearing',
'Olfaction',
'Taste',
'Interoception',
'Touch',
'Mouth_throat',
'Head',
'Torso',
'Hand_arm',
'Foot_leg'
)))
df_diffs %>%
filter(word == "market") %>%
ggplot(aes(x = Dimension,
y = Diff,
fill = Dimension)) +
geom_bar(stat = "summary") +
geom_vline(xintercept = 0, linetype = "dotted") +
theme_bw() +
coord_flip() +
labs(x = "Dimension",
y = "Deviation from Lancaster Norms") +
scale_fill_manual(values = viridisLite::viridis(11, option = "mako",
begin = 0.8, end = 0.15)) +
facet_wrap(~sentence) +
theme(text = element_text(size=16)) +
guides(fill = FALSE)## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
We also look at this across all words:
df_diffs %>%
ggplot(aes(x = reorder(Dimension, Diff),
y = Diff)) +
geom_violin() +
geom_jitter(alpha = .1,
width = .1) +
geom_hline(yintercept = 0, linetype = "dotted") +
theme_bw() +
coord_flip() +
labs(x = "Dimension",
y = "Deviation from Lancaster Norms") +
theme(text = element_text(size=16))
How does dominance relate to deviation from the LS Norms?
This question can in turn be decomposed into two questions:
First, are more dominant senses closer to the LS Norms overall? We might expect this to be the case if the LS Norms reflect the dominant sense; that is, when people rate the sensorimotor properties of a decontextualized word, they might be more likely to index properties associated with the most dominant contexts or meanings of that word.
And the answer is yes: more dominant senses are indeed more similar (less distant) from the Lancaster norm in terms of their sensorimotor profile.
model_with_dominance = lmer(data = df_dom_plus_sm,
distance_to_lancaster ~ dominance + (1 | word),
REML = FALSE)
model_no_dominance = lmer(data = df_dom_plus_sm,
distance_to_lancaster ~ (1 | word),
REML = FALSE)
summary(model_with_dominance)## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
## method [lmerModLmerTest]
## Formula: distance_to_lancaster ~ dominance + (1 | word)
## Data: df_dom_plus_sm
##
## AIC BIC logLik -2*log(L) df.resid
## -1305.6 -1289.2 656.8 -1313.6 444
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.8511 -0.5791 -0.2326 0.4193 4.0935
##
## Random effects:
## Groups Name Variance Std.Dev.
## word (Intercept) 0.000806 0.02839
## Residual 0.002542 0.05042
## Number of obs: 448, groups: word, 112
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.077717 0.003605 114.138534 21.56 < 2e-16 ***
## dominance -0.009957 0.002981 344.678498 -3.34 0.000929 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## dominance 0.099anova(model_with_dominance, model_no_dominance)## Data: df_dom_plus_sm
## Models:
## model_no_dominance: distance_to_lancaster ~ (1 | word)
## model_with_dominance: distance_to_lancaster ~ dominance + (1 | word)
## npar AIC BIC logLik -2*log(L) Chisq Df Pr(>Chisq)
## model_no_dominance 3 -1296.7 -1284.4 651.35 -1302.7
## model_with_dominance 4 -1305.6 -1289.2 656.82 -1313.6 10.934 1 0.0009444
##
## model_no_dominance
## model_with_dominance ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1df_dom_plus_sm %>%
ggplot(aes(x = dominance,
y = distance_to_lancaster)) +
geom_point(alpha = .5) +
geom_smooth(method = "lm") +
labs(x = "Dominance",
y = "Cosine Distance to Decontextualized LS Norm") +
theme_bw()## `geom_smooth()` using formula = 'y ~ x'
cor.test(df_dom_plus_sm$dominance, df_dom_plus_sm$distance_to_lancaster)##
## Pearson's product-moment correlation
##
## data: df_dom_plus_sm$dominance and df_dom_plus_sm$distance_to_lancaster
## t = -2.7295, df = 446, p-value = 0.006594
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.21823310 -0.03596218
## sample estimates:
## cor
## -0.1281799And second: does dominance predict the direction of difference?
The earlier analysis of dominance suggests that more dominant senses are more concrete than less dominant senses. Thus, we might expect that more dominant senses are also more concrete on average than the decontextualized norms.
We find that this is true: that is, more dominant senses are more concrete on average than the LS norm.
df_diffs_avg = df_diffs %>%
group_by(word, sentence, context) %>%
summarise(mean_diff = mean(Diff))## `summarise()` has grouped output by 'word', 'sentence'. You can override using
## the `.groups` argument.df_diffs_avg = df_diffs_avg %>%
left_join(df_dom_plus_sm)## Joining with `by = join_by(word, sentence, context)`model_with_dominance = lmer(data = df_diffs_avg,
mean_diff ~ dominance + (1 | word),
REML = FALSE)
model_no_dominance = lmer(data = df_diffs_avg,
mean_diff ~ (1 | word),
REML = FALSE)
summary(model_with_dominance)## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
## method [lmerModLmerTest]
## Formula: mean_diff ~ dominance + (1 | word)
## Data: df_diffs_avg
##
## AIC BIC logLik -2*log(L) df.resid
## 114.1 130.5 -53.1 106.1 444
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.8348 -0.5528 -0.0351 0.5782 2.8769
##
## Random effects:
## Groups Name Variance Std.Dev.
## word (Intercept) 0.04174 0.2043
## Residual 0.05175 0.2275
## Number of obs: 448, groups: word, 112
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 9.659e-03 2.216e-02 1.132e+02 0.436 0.664
## dominance 8.583e-02 1.349e-02 3.407e+02 6.361 6.44e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## dominance 0.073anova(model_with_dominance, model_no_dominance)## Data: df_diffs_avg
## Models:
## model_no_dominance: mean_diff ~ (1 | word)
## model_with_dominance: mean_diff ~ dominance + (1 | word)
## npar AIC BIC logLik -2*log(L) Chisq Df Pr(>Chisq)
## model_no_dominance 3 150.36 162.67 -72.179 144.36
## model_with_dominance 4 114.12 130.54 -53.062 106.12 38.235 1 6.271e-10
##
## model_no_dominance
## model_with_dominance ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1cor.test(df_diffs_avg$dominance, df_diffs_avg$mean_diff)##
## Pearson's product-moment correlation
##
## data: df_diffs_avg$dominance and df_diffs_avg$mean_diff
## t = 4.7696, df = 446, p-value = 2.504e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.1303131 0.3066838
## sample estimates:
## cor
## 0.2202983Predicting relatedness
Next, we ask about the sensorimotor distance between
two sentence pairs, and whether it correlates both with
same/different sense and the mean_relatedness
judgments for those sentence pairs.
Here, we load a version of the dataset that also contains a baseline measure: the sensorimotor distance as calculated using a bag-of-words approach (i.e., using the original Lancaster Norms).
Load data
df_rawc_with_norms = read_csv("../../data/processed/sentence_pairs_with_sensorimotor_distance.csv") %>%
drop_na(sensorimotor_distance) %>%
select(sensorimotor_distance, action_distance, perceptual_distance,
word, same, ambiguity_type, sentence1, sentence2, mean_relatedness, Class)## Rows: 672 Columns: 22
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): word, sentence1, sentence2, ambiguity_type, disambiguating_word1, ...
## dbl (11): mean_relatedness, median_relatedness, diff, count, sd_relatedness,...
## lgl (1): same
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.nrow(df_rawc_with_norms)## [1] 672Load English RAW-C data
df_bert = read_csv("../../data/processed/models_english/rawc-distances_model-bert-base-uncased.csv") %>%
mutate(Model = "BERT-base-uncased",
Multilingual = "Monolingual")## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_bert_cased = read_csv("../../data/processed/models_english/rawc-distances_model-bert-base-cased.csv") %>%
mutate(Model = "BERT-base-cased",
Multilingual = "Monolingual")## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_xlm = read_csv("../../data/processed/models_english/rawc-distances_model-xlm-roberta-base.csv") %>%
mutate(Model = "XLM-RoBERTa",
Multilingual = "Multilingual")## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_ab1 = read_csv("../../data/processed/models_english/rawc-distances_model-albert-base-v1.csv") %>%
mutate(Model = "ALBERT-base-v1",
Multilingual = "Monolingual")## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_ab2 = read_csv("../../data/processed/models_english/rawc-distances_model-albert-base-v2.csv") %>%
mutate(Model = "ALBERT-base-v2",
Multilingual = "Monolingual")## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_al = read_csv("../../data/processed/models_english/rawc-distances_model-albert-large-v2.csv") %>%
mutate(Model = "ALBERT-large-v2",
Multilingual = "Monolingual")## Rows: 16800 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_axl = read_csv("../../data/processed/models_english/rawc-distances_model-albert-xlarge-v2.csv") %>%
mutate(Model = "ALBERT-xlarge-v2",
Multilingual = "Monolingual")## Rows: 16800 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_axxl = read_csv("../../data/processed/models_english/rawc-distances_model-albert-xxlarge-v2.csv") %>%
mutate(Model = "ALBERT-xxlarge-v2",
Multilingual = "Monolingual")## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_rb = read_csv("../../data/processed/models_english/rawc-distances_model-roberta-base.csv") %>%
mutate(Model = "RoBERTa-base",
Multilingual = "Monolingual")## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_rl = read_csv("../../data/processed/models_english/rawc-distances_model-roberta-large.csv") %>%
mutate(Model = "RoBERTa-large",
Multilingual = "Monolingual")## Rows: 16800 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_db = read_csv("../../data/processed/models_english/rawc-distances_model-distilbert-base-uncased.csv") %>%
mutate(Model = "DistilBERT",
Multilingual = "Monolingual")## Rows: 4704 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_mb = read_csv("../../data/processed/models_english/rawc-distances_model-bert-base-multilingual-cased.csv") %>%
mutate(Model = "Multilingual BERT",
Multilingual = "Multilingual")## Rows: 8736 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): sentence1, sentence2, word, string
## dbl (6): Distance, Layer, S1_ntokens, S2_ntokens, token_diffs, n_params
## lgl (1): Same_sense
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.df_all = df_bert %>%
bind_rows(df_bert_cased) %>%
bind_rows(df_xlm) %>%
bind_rows(df_ab1) %>%
bind_rows(df_ab2) %>%
bind_rows(df_al) %>%
bind_rows(df_axl) %>%
bind_rows(df_axxl) %>%
bind_rows(df_rb) %>%
bind_rows(df_rl) %>%
bind_rows(df_db) %>%
bind_rows(df_mb)
df_merged = df_rawc_with_norms %>%
inner_join(df_all)## Joining with `by = join_by(word, sentence1, sentence2)`Predicting same/different sense
Sensorimotor distance and sense boundaries
df_rawc_with_norms = df_rawc_with_norms %>%
mutate(Same = case_when(
same == TRUE ~ "Same Sense",
same == FALSE ~ "Different Sense"
))
df_rawc_with_norms %>%
ggplot(aes(x = sensorimotor_distance,
y = ambiguity_type,
fill = Same)) +
geom_density_ridges2(aes(height = ..density..),
color = NA,
alpha = 0.5,
scale=0.85,
stat="density") +
labs(x = "Sensorimotor Distance",
y = NULL,
fill = NULL) +
scale_fill_manual(
values = c("Same Sense" = viridisLite::viridis(2, option = "mako", begin = 0.8, end = 0.15)[1],
"Different Sense" = viridisLite::viridis(2, option = "mako", begin = 0.8, end = 0.15)[2])
) +
theme_minimal() +
theme(text = element_text(size = 20))## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
model_full = lmer(data = df_rawc_with_norms,
sensorimotor_distance ~ same +
(1 + same | word),
control=lmerControl(optimizer="bobyqa"),
REML = FALSE)## boundary (singular) fit: see help('isSingular')model_reduced = lmer(data = df_rawc_with_norms,
sensorimotor_distance ~ # same +
(1 + same | word),
control=lmerControl(optimizer="bobyqa"),
REML = FALSE)## boundary (singular) fit: see help('isSingular')summary(model_full)## Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
## method [lmerModLmerTest]
## Formula: sensorimotor_distance ~ same + (1 + same | word)
## Data: df_rawc_with_norms
## Control: lmerControl(optimizer = "bobyqa")
##
## AIC BIC logLik -2*log(L) df.resid
## -2203.5 -2176.4 1107.7 -2215.5 666
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.0011 -0.5738 -0.1294 0.4572 3.7891
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## word (Intercept) 0.003693 0.06077
## sameTRUE 0.002874 0.05361 -1.00
## Residual 0.001447 0.03803
## Number of obs: 672, groups: word, 112
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 0.100224 0.006017 112.005213 16.658 <2e-16 ***
## sameTRUE -0.057033 0.005946 117.316950 -9.592 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr)
## sameTRUE -0.903
## optimizer (bobyqa) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')anova(model_full, model_reduced)## Data: df_rawc_with_norms
## Models:
## model_reduced: sensorimotor_distance ~ (1 + same | word)
## model_full: sensorimotor_distance ~ same + (1 + same | word)
## npar AIC BIC logLik -2*log(L) Chisq Df Pr(>Chisq)
## model_reduced 5 -2137.8 -2115.3 1073.9 -2147.8
## model_full 6 -2203.5 -2176.4 1107.7 -2215.5 67.654 1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Predicting sense boundaries
Here, we run the actual analysis:
model_sm_only <- glm(same ~ sensorimotor_distance,
data = df_rawc_with_norms,
family = binomial)
aic_sm_baseline <- AIC(model_sm_only)
print(paste("AIC:", round(aic_sm_baseline, 1)))## [1] "AIC: 707.3"### Get aic
aic_results <- df_merged %>%
group_by(n_params, Model, Layer) %>%
summarize(
# BERT only
aic_bert = {
model <- glm(Same_sense ~ Distance, family = binomial)
AIC(model)
},
# Combined
aic_combined = {
model <- glm(Same_sense ~ Distance + sensorimotor_distance, family = binomial)
AIC(model)
},
aic_sm = {
model <- glm(Same_sense ~ sensorimotor_distance, family = binomial)
AIC(model)
},
.groups = "drop"
) %>%
mutate(
# AIC Delta
aic_bert_vs_sm = aic_bert - aic_sm_baseline,
aic_combined_vs_sm = aic_sm_baseline - aic_combined,
aic_combined_vs_dist = aic_bert - aic_combined
)
# ============================================================
# 3. Best layer per model
# ============================================================
best_layers <- aic_results %>%
group_by(Model, n_params) %>%
slice_min(aic_bert, n = 1) %>%
select(Model, Layer,
aic_bert_vs_sm, aic_combined_vs_sm, aic_combined_vs_dist,
aic_sm, aic_bert, aic_combined)## Adding missing grouping variables: `n_params`best_layers = best_layers %>%
mutate(aic_bert_vs_sm2 = aic_bert - aic_sm_baseline)
print(best_layers)## # A tibble: 12 × 10
## # Groups: Model, n_params [12]
## n_params Model Layer aic_bert_vs_sm aic_combined_vs_sm aic_combined_vs_dist
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 11683584 ALBER… 8 29.8 80.3 110.
## 2 11683584 ALBER… 12 -80.9 144. 62.8
## 3 17683968 ALBER… 9 -38.1 115. 76.8
## 4 58724864 ALBER… 13 -165. 201. 36.3
## 5 222595584 ALBER… 7 -250. 279. 28.5
## 6 108310272 BERT-… 12 -117. 169. 52.2
## 7 109482240 BERT-… 12 -176. 214. 37.3
## 8 66362880 Disti… 6 -104. 153. 49.3
## 9 177853440 Multi… 8 34.3 75.0 109.
## 10 124645632 RoBER… 8 -138. 194. 55.9
## 11 355359744 RoBER… 16 -256. 273. 17.1
## 12 278043648 XLM-R… 6 103. 18.3 121.
## # ℹ 4 more variables: aic_sm <dbl>, aic_bert <dbl>, aic_combined <dbl>,
## # aic_bert_vs_sm2 <dbl>## AIC difference from SM baseline
best_layers %>%
select(Model, aic_bert_vs_sm, aic_combined_vs_sm) %>%
pivot_longer(cols = c(aic_bert_vs_sm, aic_combined_vs_sm),
names_to = "type", values_to = "aic_diff") %>%
mutate(type = ifelse(type == "aic_bert_vs_sm",
"Distributional only",
"Distributional + Sensorimotor"),
type = factor(type, levels = c("Distributional only",
"Distributional + Sensorimotor")),
Model = fct_reorder(Model, aic_diff)) %>%
ggplot(aes(x = aic_diff, y = Model, fill = type)) +
geom_col(position = "dodge") +
geom_vline(xintercept = 0, linetype = "dashed", color = "red") +
labs(x = "ΔAIC vs. Sensorimotor baseline",
y = NULL,
fill = NULL) +
scale_fill_manual(values = c("Distributional only" = "gray60",
"Distributional + Sensorimotor" = "steelblue")) +
theme_minimal() +
theme(text = element_text(size = 16),
legend.position = "bottom")## Adding missing grouping variables: `n_params`
best_layers %>%
select(Model, aic_bert_vs_sm, aic_combined_vs_sm) %>%
pivot_longer(cols = c(aic_bert_vs_sm, aic_combined_vs_sm),
names_to = "type", values_to = "aic_diff") %>%
mutate(type = ifelse(type == "aic_bert_vs_sm",
"Distributional only",
"Distributional + Sensorimotor"),
type = factor(type, levels = c("Distributional only",
"Distributional + Sensorimotor")),
Model = fct_reorder(Model, aic_diff)) %>%
ggplot(aes(x = n_params,
y = aic_diff,
color = type)) +
geom_point(size = 6,
alpha = .7) +
scale_x_log10() +
geom_hline(yintercept = 0, linetype = "dotted", color = "black") +
labs(x = "Parameters",
y = "ΔAIC vs. Sensorimotor baseline",
color = "",
title = "Predicting Sense Boundaries") +
scale_color_manual(values = c("Distributional only" = "gray60",
"Distributional + Sensorimotor" = "steelblue")) +
theme_minimal() +
# guides(color="none") +
theme(text = element_text(size = 15),
legend.position="bottom")## Adding missing grouping variables: `n_params`
aic_results %>%
mutate(dist_better_than_sm = aic_bert_vs_sm > 4,
hybrid_better_than_sm = aic_combined_vs_sm > 4,
hybrid_better_than_dist = aic_combined_vs_dist > 4) %>%
summarise(mean(dist_better_than_sm),
mean(hybrid_better_than_sm),
mean(hybrid_better_than_dist))## # A tibble: 1 × 3
## `mean(dist_better_than_sm)` mean(hybrid_better_than_s…¹ mean(hybrid_better_t…²
## <dbl> <dbl> <dbl>
## 1 0.414 0.925 1
## # ℹ abbreviated names: ¹`mean(hybrid_better_than_sm)`,
## # ²`mean(hybrid_better_than_dist)`best_layers %>%
ungroup() %>%
mutate(dist_better_than_sm = aic_bert_vs_sm < -4,
hybrid_better_than_sm = aic_combined_vs_sm > 4,
hybrid_better_than_dist = aic_combined_vs_dist > 4) %>%
summarise(mean(dist_better_than_sm),
mean(hybrid_better_than_sm),
mean(hybrid_better_than_dist))## # A tibble: 1 × 3
## `mean(dist_better_than_sm)` mean(hybrid_better_than_s…¹ mean(hybrid_better_t…²
## <dbl> <dbl> <dbl>
## 1 0.75 1 1
## # ℹ abbreviated names: ¹`mean(hybrid_better_than_sm)`,
## # ²`mean(hybrid_better_than_dist)`### Visualize raw AIC
aic_summary_full <- best_layers %>%
select(Model, Layer, aic_sm, aic_bert, aic_combined) %>%
pivot_longer(cols = c(aic_sm, aic_bert, aic_combined),
names_to = "type", values_to = "aic") %>%
mutate(type = case_when(
type == "aic_sm" ~ "Sensorimotor",
type == "aic_bert" ~ "Distributional",
type == "aic_combined" ~ "Hybrid"
),
type = factor(type, levels = c("Sensorimotor", "Distributional", "Hybrid")))## Adding missing grouping variables: `n_params`# Get sensorimotor baseline (should be the same for all models)
aic_sm_baseline <- aic_summary_full %>%
filter(type == "Sensorimotor") %>%
pull(aic) %>%
unique()
# Filter to just distributional and hybrid
aic_summary_no_sm <- aic_summary_full %>%
filter(type != "Sensorimotor")
aic_summary_se_no_sm <- aic_summary_no_sm %>%
group_by(type) %>%
summarize(
mean_aic = mean(aic),
se_aic = sd(aic) / sqrt(n())
)
ggplot() +
# Sensorimotor baseline as dashed line
geom_hline(yintercept = aic_sm_baseline,
linetype = "dashed", color = "coral", linewidth = 1) +
# Raw points for each model/layer
geom_jitter(data = aic_summary_no_sm,
aes(x = type, y = aic, color = type),
alpha = 0.3, width = 0.1, size = 2) +
# Mean + SE
geom_point(data = aic_summary_se_no_sm,
aes(x = type, y = mean_aic, color = type),
size = 5) +
geom_errorbar(data = aic_summary_se_no_sm,
aes(x = type, ymin = mean_aic - se_aic,
ymax = mean_aic + se_aic, color = type),
width = 0.15, linewidth = 1.2) +
annotate("text", x = 1.5, y = aic_sm_baseline + 30,
label = "Sensorimotor", color = "coral", size = 5)+
labs(x = NULL,
y = "AIC (lower is better)",
title = "Predicting Sense Boundary") +
scale_color_manual(values = c("Distributional" = "gray60",
"Hybrid" = "steelblue")) +
theme_minimal() +
theme(text = element_text(size = 16),
legend.position = "none")
Predicting relatedness
Comparing to each distributional relatedness measure
df_rawc_with_norms %>%
ggplot(aes(x = sensorimotor_distance,
y = mean_relatedness,
color = Same)) +
geom_point(alpha = .5) +
scale_color_manual(
values = c("Same Sense" = viridisLite::viridis(2, option = "mako",
begin = 0.8, end = 0.15)[1],
"Different Sense" = viridisLite::viridis(2, option = "mako",
begin = 0.8, end = 0.15)[2])
) +
theme_minimal() +
labs(x = "Sensorimotor Distance",
y = "Mean Relatedness",
color = "") +
theme(text = element_text(size = 15),
legend.position="bottom")
cor(df_rawc_with_norms$sensorimotor_distance,
df_rawc_with_norms$mean_relatedness)## [1] -0.5346106Comparing AIC
# ============================================================
# 1. Sensorimotor only (baseline)
# ============================================================
model_sm_only <- lm(mean_relatedness ~ sensorimotor_distance,
data = df_merged)
r2_sm_baseline <- summary(model_sm_only)$r.squared
aic_sm_baseline <- AIC(model_sm_only)
print(paste("Sensorimotor baseline - R²:", round(r2_sm_baseline, 3), "AIC:", round(aic_sm_baseline, 1)))## [1] "Sensorimotor baseline - R²: 0.286 AIC: 395959.1"# ============================================================
# 2. For each model/layer: compute R² and AIC, difference from SM baseline
# ============================================================
relatedness_results <- df_merged %>%
group_by(Model, Layer, n_params, Multilingual) %>%
summarize(
# Sensorimotor only
r2_sm = {
model <- lm(mean_relatedness ~ sensorimotor_distance)
summary(model)$r.squared
},
aic_sm = {
model <- lm(mean_relatedness ~ sensorimotor_distance)
AIC(model)
},
# BERT only
r2_bert = {
model <- lm(mean_relatedness ~ Distance)
summary(model)$r.squared
},
aic_bert = {
model <- lm(mean_relatedness ~ Distance)
AIC(model)
},
# Combined
r2_combined = {
model <- lm(mean_relatedness ~ Distance + sensorimotor_distance)
summary(model)$r.squared
},
aic_combined = {
model <- lm(mean_relatedness ~ Distance + sensorimotor_distance)
AIC(model)
},
.groups = "drop"
) %>%
mutate(
aic_bert_vs_sm = aic_bert - aic_sm,
aic_combined_vs_sm = aic_sm - aic_combined,
aic_combined_vs_dist = aic_bert - aic_combined
)
# ============================================================
# 3. Best layer per model
# ============================================================
best_layers <- relatedness_results %>%
group_by(Model, n_params, Multilingual) %>%
slice_max(r2_bert, n = 1) %>%
select(Model, Layer, n_params, Multilingual,
# r2_sm, r2_bert, r2_combined,
aic_bert_vs_sm, aic_sm, aic_bert, aic_combined,
aic_combined_vs_sm, aic_combined_vs_dist)
print(best_layers)## # A tibble: 12 × 10
## # Groups: Model, n_params, Multilingual [12]
## Model Layer n_params Multilingual aic_bert_vs_sm aic_sm aic_bert aic_combined
## <chr> <dbl> <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 ALBE… 9 1.17e7 Monolingual 111. 2135. 2246. 2053.
## 2 ALBE… 12 1.17e7 Monolingual 4.57 2135. 2139. 1997.
## 3 ALBE… 14 1.77e7 Monolingual 7.41 2135. 2142. 2002.
## 4 ALBE… 15 5.87e7 Monolingual -140. 2135. 1995. 1878.
## 5 ALBE… 8 2.23e8 Monolingual -234. 2135. 1901. 1790.
## 6 BERT… 12 1.08e8 Monolingual -96.8 2135. 2038. 1911.
## 7 BERT… 12 1.09e8 Monolingual -175. 2135. 1960. 1855.
## 8 Dist… 6 6.64e7 Monolingual -79.2 2135. 2056. 1937.
## 9 Mult… 12 1.78e8 Multilingual 90.7 2135. 2225. 2062.
## 10 RoBE… 11 1.25e8 Monolingual -117. 2135. 2018. 1899.
## 11 RoBE… 22 3.55e8 Monolingual -291. 2135. 1844. 1759.
## 12 XLM-… 9 2.78e8 Multilingual 143. 2135. 2277. 2088.
## # ℹ 2 more variables: aic_combined_vs_sm <dbl>, aic_combined_vs_dist <dbl>best_layers %>%
select(Model, aic_bert_vs_sm, aic_combined_vs_sm) %>%
pivot_longer(cols = c(aic_bert_vs_sm, aic_combined_vs_sm),
names_to = "type", values_to = "aic_diff") %>%
mutate(type = ifelse(type == "aic_bert_vs_sm", "Distributional only", "Distributional + Sensorimotor"),
type = factor(type, levels = c("Distributional only", "Distributional + Sensorimotor")),
Model = fct_reorder(Model, aic_diff)) %>%
ggplot(aes(x = aic_diff, y = Model, fill = type)) +
geom_col(position = "dodge") +
geom_vline(xintercept = 0, linetype = "dashed", color = "red") +
geom_vline(xintercept = 4, linetype = "dotted", color = "gray50") +
geom_vline(xintercept = -4, linetype = "dotted", color = "gray50") +
labs(x = "ΔAIC vs. Sensorimotor baseline",
y = NULL,
fill = NULL) +
scale_fill_manual(values = c("Distributional only" = "gray60",
"Distributional + Sensorimotor" = "steelblue")) +
theme_minimal() +
theme(text = element_text(size = 16),
legend.position = "bottom")## Adding missing grouping variables: `n_params`, `Multilingual`
# ============================================================
# 7. Summary
# ============================================================
best_layers %>%
ungroup() %>%
mutate(dist_better_than_sm = aic_bert_vs_sm < -4,
hybrid_better_than_sm = aic_combined_vs_sm > 4,
hybrid_better_than_dist = aic_combined_vs_dist > 4) %>%
summarise(mean(dist_better_than_sm),
mean(hybrid_better_than_sm),
mean(hybrid_better_than_dist))## # A tibble: 1 × 3
## `mean(dist_better_than_sm)` mean(hybrid_better_than_s…¹ mean(hybrid_better_t…²
## <dbl> <dbl> <dbl>
## 1 0.583 1 1
## # ℹ abbreviated names: ¹`mean(hybrid_better_than_sm)`,
## # ²`mean(hybrid_better_than_dist)`### Visualize raw AIC
aic_summary_full <- best_layers %>%
select(Model, Layer, aic_sm, aic_bert, aic_combined) %>%
pivot_longer(cols = c(aic_sm, aic_bert, aic_combined),
names_to = "type", values_to = "aic") %>%
mutate(type = case_when(
type == "aic_sm" ~ "Sensorimotor",
type == "aic_bert" ~ "Distributional",
type == "aic_combined" ~ "Hybrid"
),
type = factor(type, levels = c("Sensorimotor", "Distributional", "Hybrid")))## Adding missing grouping variables: `n_params`, `Multilingual`# Get sensorimotor baseline (should be the same for all models)
aic_sm_baseline <- aic_summary_full %>%
filter(type == "Sensorimotor") %>%
pull(aic) %>%
unique()
# Filter to just distributional and hybrid
aic_summary_no_sm <- aic_summary_full %>%
filter(type != "Sensorimotor")
aic_summary_se_no_sm <- aic_summary_no_sm %>%
group_by(type) %>%
summarize(
mean_aic = mean(aic),
se_aic = sd(aic) / sqrt(n())
)
ggplot() +
# Sensorimotor baseline as dashed line
geom_hline(yintercept = aic_sm_baseline,
linetype = "dashed", color = "coral", linewidth = 1) +
# Raw points for each model/layer
geom_jitter(data = aic_summary_no_sm,
aes(x = type, y = aic, color = type),
alpha = 0.3, width = 0.1, size = 2) +
# Mean + SE
geom_point(data = aic_summary_se_no_sm,
aes(x = type, y = mean_aic, color = type),
size = 5) +
geom_errorbar(data = aic_summary_se_no_sm,
aes(x = type, ymin = mean_aic - se_aic,
ymax = mean_aic + se_aic, color = type),
width = 0.15, linewidth = 1.2) +
annotate("text", x = 1.5, y = aic_sm_baseline + 30,
label = "Sensorimotor", color = "coral", size = 5)+
labs(x = NULL,
y = "AIC (lower is better)",
title = "Predicting Relatedness") +
scale_color_manual(values = c("Distributional" = "gray60",
"Hybrid" = "steelblue")) +
theme_minimal() +
theme(text = element_text(size = 16),
legend.position = "none")
Correlation between sensorimotor and distributional distance
# Get best layer
df_by_layer = df_merged %>%
group_by(Model, Multilingual, Layer, n_params) %>%
summarise(r = cor(mean_relatedness, Distance, method = "pearson"),
r2 = r ** 2,
rho = cor(mean_relatedness, Distance, method = "spearman"),
count = n())## `summarise()` has grouped output by 'Model', 'Multilingual', 'Layer'. You can
## override using the `.groups` argument.df_best_layer <- df_by_layer %>%
group_by(Model) %>%
slice_max(r2, n = 1) %>%
select(Model, Layer, r2)
# Filter for only best layers
df_best <- df_merged %>%
semi_join(df_best_layer, by = c("Model", "Layer"))
# Pivot wider
df_wide <- df_best %>%
mutate(`Sensorimotor Distance` = sensorimotor_distance) %>%
select(word, sentence1, sentence2, `Sensorimotor Distance`, Model, Distance) %>%
pivot_wider(names_from = Model, values_from = Distance)
# Compute correlation matrix
cor_matrix <- df_wide %>%
select(`Sensorimotor Distance`, where(is.numeric)) %>%
cor(use = "pairwise.complete.obs")
# Plot the correlation matrix
ggcorrplot(cor_matrix,
hc.order = FALSE,
method = "square") +
theme(
axis.text.x = element_text(size = 10, angle = 45, hjust = 1),
axis.text.y = element_text(size = 10)
)
Baseline with LS Norms
df_with_baseline = read_csv("../../data/processed/sentence_pairs_with_baseline.csv") %>%
drop_na(sensorimotor_distance) %>%
drop_na(baseline_distance)## Rows: 672 Columns: 23
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (10): word, sentence1, sentence2, ambiguity_type, disambiguating_word1, ...
## dbl (12): mean_relatedness, median_relatedness, diff, count, sd_relatedness,...
## lgl (1): same
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.nrow(df_with_baseline)## [1] 576